home *** CD-ROM | disk | FTP | other *** search
/ Gurewich OLE Controls for Visual Basic 4 / Gurewich OLE Controls for Visual Basic 4.iso / ocxprog / programs / ch11 / dice.frm (.txt) next >
Encoding:
Visual Basic Form  |  1995-08-24  |  10.5 KB  |  319 lines
  1. VERSION 4.00
  2. Begin VB.Form frmDice 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "The Dice Program"
  6.    ClientHeight    =   4515
  7.    ClientLeft      =   990
  8.    ClientTop       =   1695
  9.    ClientWidth     =   6720
  10.    Height          =   5205
  11.    Icon            =   "DICE.frx":0000
  12.    Left            =   930
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   4515
  16.    ScaleWidth      =   6720
  17.    Top             =   1065
  18.    Width           =   6840
  19.    Begin VB.CommandButton cmdChangeBackground 
  20.       Caption         =   "&Change Background Color"
  21.       Height          =   495
  22.       Left            =   2160
  23.       TabIndex        =   7
  24.       Top             =   3960
  25.       Width           =   2415
  26.    End
  27.    Begin VB.HScrollBar hsbGuess 
  28.       Height          =   255
  29.       Left            =   2160
  30.       Max             =   12
  31.       Min             =   2
  32.       TabIndex        =   5
  33.       Top             =   3600
  34.       Value           =   7
  35.       Width           =   2415
  36.    End
  37.    Begin VB.Timer Timer1 
  38.       Interval        =   50
  39.       Left            =   0
  40.       Top             =   720
  41.    End
  42.    Begin VB.Line linBackDoor 
  43.       Visible         =   0   'False
  44.       X1              =   6600
  45.       X2              =   6660
  46.       Y1              =   60
  47.       Y2              =   0
  48.    End
  49.    Begin VB.Label lblGuessValue 
  50.       Caption         =   "7"
  51.       BeginProperty Font 
  52.          name            =   "MS Sans Serif"
  53.          charset         =   0
  54.          weight          =   400
  55.          size            =   13.5
  56.          underline       =   0   'False
  57.          italic          =   0   'False
  58.          strikethrough   =   0   'False
  59.       EndProperty
  60.       Height          =   375
  61.       Left            =   3960
  62.       TabIndex        =   6
  63.       Top             =   3120
  64.       Width           =   495
  65.    End
  66.    Begin VB.Label lblYourGuess 
  67.       Caption         =   "Your Guess:"
  68.       BeginProperty Font 
  69.          name            =   "MS Sans Serif"
  70.          charset         =   0
  71.          weight          =   400
  72.          size            =   13.5
  73.          underline       =   0   'False
  74.          italic          =   0   'False
  75.          strikethrough   =   0   'False
  76.       EndProperty
  77.       Height          =   375
  78.       Left            =   2160
  79.       TabIndex        =   4
  80.       Top             =   3120
  81.       Width           =   1695
  82.    End
  83.    Begin VB.Label lblGameResult 
  84.       Alignment       =   2  'Center
  85.       Caption         =   "To roll the dice, click any of the dice"
  86.       BeginProperty Font 
  87.          name            =   "MS Sans Serif"
  88.          charset         =   0
  89.          weight          =   400
  90.          size            =   24
  91.          underline       =   0   'False
  92.          italic          =   0   'False
  93.          strikethrough   =   0   'False
  94.       EndProperty
  95.       Height          =   1215
  96.       Left            =   840
  97.       TabIndex        =   3
  98.       Top             =   120
  99.       Width           =   4935
  100.    End
  101.    Begin TegoswLibCtl.Tegosw swExit 
  102.       Height          =   630
  103.       Left            =   0
  104.       TabIndex        =   2
  105.       Top             =   0
  106.       Width           =   525
  107.       _version        =   65536
  108.       _extentx        =   926
  109.       _extenty        =   1111
  110.       _stockprops     =   64
  111.       value           =   -1  'True
  112.    End
  113.    Begin TegdiceLibCtl.TegoDice TegoDice2 
  114.       Height          =   1545
  115.       Left            =   5280
  116.       TabIndex        =   1
  117.       Top             =   1560
  118.       Width           =   1290
  119.       _version        =   65536
  120.       _extentx        =   2275
  121.       _extenty        =   2725
  122.       _stockprops     =   65
  123.       picture1        =   "DICE.frx":030A
  124.       picture2        =   "DICE.frx":0326
  125.       picture3        =   "DICE.frx":0342
  126.       picture4        =   "DICE.frx":035E
  127.       picture5        =   "DICE.frx":037A
  128.       picture6        =   "DICE.frx":0396
  129.    End
  130.    Begin TegdiceLibCtl.TegoDice TegoDice1 
  131.       Height          =   1545
  132.       Left            =   120
  133.       TabIndex        =   0
  134.       Top             =   1560
  135.       Width           =   1290
  136.       _version        =   65536
  137.       _extentx        =   2275
  138.       _extenty        =   2725
  139.       _stockprops     =   65
  140.       autosize        =   -1  'True
  141.       picture1        =   "DICE.frx":03B2
  142.       picture2        =   "DICE.frx":03CE
  143.       picture3        =   "DICE.frx":03EA
  144.       picture4        =   "DICE.frx":0406
  145.       picture5        =   "DICE.frx":0422
  146.       picture6        =   "DICE.frx":043E
  147.    End
  148.    Begin VB.Menu mnuFile 
  149.       Caption         =   "&File"
  150.       Begin VB.Menu mnuExit 
  151.          Caption         =   "E&xit"
  152.       End
  153.    End
  154.    Begin VB.Menu mnuHelp 
  155.       Caption         =   "&Help"
  156.       Begin VB.Menu mnuAbout 
  157.          Caption         =   "About..."
  158.       End
  159.    End
  160. Attribute VB_Name = "frmDice"
  161. Attribute VB_Creatable = False
  162. Attribute VB_Exposed = False
  163. ' All variables must be declared.
  164. Option Explicit
  165. ' The Rolling In Progress flag.
  166. Dim gRollingInProgress
  167. Private Sub cmdChangeBackground_Click()
  168.  Static Background
  169.  ' Increment the Background static variable
  170.  Background = Background + 1
  171.  ' If Background is greater than 15, reset it to 1.
  172.  If Background > 15 Then Background = 1
  173.  ' Change the color of the form according to the
  174.  ' current value of Background.
  175.  Me.BackColor = QBColor(Background)
  176.  ' Change the background color of the two dice
  177.  ' controls and the three label controls to the
  178.  ' new color of the form.
  179.  TegoDice1.BackColor = Me.BackColor
  180.  TegoDice2.BackColor = Me.BackColor
  181.  lblGameResult.BackColor = Me.BackColor
  182.  lblYourGuess.BackColor = Me.BackColor
  183.  lblGuessValue.BackColor = Me.BackColor
  184. End Sub
  185. Private Sub Form_DblClick()
  186. ' Toggle the Visible property of
  187. ' the linBackDoor line.
  188. linBackDoor.Visible = Not linBackDoor.Visible
  189. End Sub
  190. Private Sub Form_Load()
  191.    ' Reset the gRollingInProgress flag to False.
  192.    gRollingInProgress = False
  193. End Sub
  194. Private Sub hsbGuess_Change()
  195.   ' Set the lblGuessValue label to the value
  196.   ' of the hsbGuess scrollbar.
  197.   lblGuessValue.Caption = Str(hsbGuess.Value)
  198. End Sub
  199. Private Sub lblGameResult_DblClick()
  200.   ' Toggle the Visible property of
  201.   ' the linBackDoor line.
  202.   linBackDoor.Visible = Not linBackDoor.Visible
  203. End Sub
  204. Private Sub mnuAbout_Click()
  205.    Dim Title
  206.    Dim Msg
  207.    Dim CR
  208.    CR = Chr(13) + Chr(10)
  209.    ' The title of the About message box.
  210.    Title = "About the Dice Program"
  211.    ' Prepare the message of the About message box.
  212.    Msg = "This program was written with Visual "
  213.    Msg = Msg + "Basic for Windows, using the "
  214.    Msg = Msg + "TegoSoft Dice OCX control. "
  215.    Msg = Msg + CR + CR
  216.    Msg = Msg + "The TegoSoft Dice OCX control "
  217.    Msg = Msg + "is part of the TegoSoft OCX Control "
  218.    Msg = Msg + "Kit - a collection of various OCX controls. "
  219.    Msg = Msg + CR + CR
  220.    Msg = Msg + "For more information about the "
  221.    Msg = Msg + "TegoSoft OCX Control Kit, contact TegoSoft "
  222.    Msg = Msg + "at:"
  223.    Msg = Msg + CR + CR
  224.    Msg = Msg + "TegoSoft Inc." + CR
  225.    Msg = Msg + "P.O. Box 389" + CR
  226.    Msg = Msg + "Bellmore, NY 11710"
  227.    Msg = Msg + CR + CR
  228.    Msg = Msg + "Phone: (516)783-4824"
  229.    ' Display the About message box.
  230.    MsgBox Msg, vbInformation, Title
  231. End Sub
  232. Private Sub mnuExit_Click()
  233. ' Terminate the program
  234. Unload Me
  235. End Sub
  236. Private Sub swExit_Click()
  237.    Dim Title
  238.    Dim Question
  239.    Dim Response
  240.    ' If the user turned the swExit switch OFF,
  241.    ' confirm that the user wants to exit the
  242.    ' program, and if so, exit the program.
  243.    If swExit.Value = False Then
  244.       Title = "Exit Program"
  245.       Question = "Are you sure you want to exit?"
  246.       Response = MsgBox(Question, vbYesNo + vbQuestion, Title)
  247.       If Response = vbYes Then
  248.          Unload Me
  249.       Else
  250.          swExit.Value = True
  251.       End If
  252.    End If
  253. End Sub
  254. Private Sub TegoDice1_ClickImage(ByVal Transparent As Boolean)
  255.   ' If the user clicked a solid section of the
  256.   ' dice, start rolling the dice.
  257.   If Transparent = False Then
  258.      ' Place the TegoDice1 dice control on the
  259.      ' right side of the form.
  260.      TegoDice1.Left = 120
  261.      
  262.      ' Place the TegoDice1 dice control on the
  263.      ' left side of the form.
  264.      TegoDice2.Left = 5280
  265.      ' Update the lblGameResult label.
  266.      lblGameResult = "Rolling the dice..."
  267.      
  268.      ' Set the gRollingInProgress flag to True.
  269.      gRollingInProgress = True
  270.   End If
  271. End Sub
  272. Private Sub TegoDice2_ClickImage(ByVal Transparent As Boolean)
  273.   ' Execute the TegoDice1_ClickImage() procedure.
  274.   TegoDice1_ClickImage (Transparent)
  275. End Sub
  276. Private Sub Timer1_Timer()
  277. ' If the gRollingInProgress flag is False,
  278. ' terminate this procedure.
  279. If gRollingInProgress = False Then Exit Sub
  280. ' Increment the Value of the two dice controls.
  281. TegoDice1.Value = TegoDice1.Value + 1
  282. TegoDice2.Value = TegoDice2.Value + 1
  283. ' Move the TegoDice1 dice control to the right by 90 twips.
  284. TegoDice1.MoveImage TegoDice1.Left + 90, _
  285.                     TegoDice1.Top, _
  286.                     TegoDice1.Width, _
  287.                     TegoDice1.Height
  288. ' Move the TegoDice2 dice control to the right by 90 twips.
  289. TegoDice2.MoveImage TegoDice2.Left - 90, _
  290.                     TegoDice2.Top, _
  291.                     TegoDice2.Width, _
  292.                     TegoDice2.Height
  293. ' If the TegoDice1 dice control has reached the
  294. ' middle of the form, stop the rolling and display
  295. ' the results of the game.
  296. If TegoDice1.Left >= 2000 Then
  297.    ' Reset the gRollingInProgress flag to False.
  298.    gRollingInProgress = False
  299.    ' Set the values of the TegoDice1 and TegoDice2
  300.    ' dice controls to random values.
  301.    TegoDice1.RandomDice
  302.    TegoDice2.RandomDice
  303.    ' If the "Back Door" line is visible,
  304.    ' make the user a winner.
  305.    If linBackDoor.Visible = True Then
  306.       TegoDice1.Value = hsbGuess.Value / 2
  307.       TegoDice2.Value = hsbGuess.Value - TegoDice1.Value
  308.    End If
  309.    ' If the sum of the two dice values is the same as the
  310.    ' user's guess, tell the user he/she won. Otherwise,
  311.    ' tell the user he/she lost.
  312.    If hsbGuess.Value = TegoDice1.Value + TegoDice2.Value Then
  313.       lblGameResult.Caption = "You won! Congratulations!!!"
  314.    Else
  315.       lblGameResult.Caption = "You lost. Please try again."
  316.    End If
  317. End If
  318. End Sub
  319.